home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995…tember: Reference Library / Dev.CD Sep 95 RL / Dev.CD Sep 95 RL.toast / mac / Technical Documentation / develop / develop Issue 5 code / Lisp Mini-App / Program / open-all-text-files.lisp < prev    next >
Encoding:
Text File  |  1992-04-08  |  1.4 KB  |  45 lines  |  [TEXT/CCL2]
  1. #|
  2. file:        open-all-text-files.lisp
  3. version:     1.0
  4. last edited: 03-12-92
  5. copyright © 1989, 1992 Steven L Mitchell/Carbon-based Metaphors.
  6.              Licensed users of MCL2 may use this code freely.
  7.  
  8.              Uses the new function choose-directory-dialog.
  9.  
  10.              The user types meta-a, and chooses a directory.
  11.              All text files in the directory are opened into Fred windows.
  12. |#
  13.  
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15. ;;;
  16. ;;; open-all-text-files
  17. ;;;
  18. ;;;     Fred command: meta-a.
  19. ;;;
  20. ;;;     Open all the text files in a directory.
  21. ;;;
  22.  
  23. (def-fred-command (:meta #\a) open-all-text-files)
  24.  
  25. (defmethod open-all-text-files ((w fred-mixin))
  26.   "Open all TEXT files in a directory."
  27.   (let (dir-pathnamestring
  28.         file-pathnames)
  29.     (setf dir-pathnamestring (choose-directory-dialog))
  30.     (setf file-pathnames
  31.           (nreverse
  32.            (directory (concatenate 'string dir-pathnamestring "*")
  33.                       :test #'(lambda (path-name)
  34.                                 (equal (mac-file-type path-name) :TEXT))
  35.                       :resolve-aliases t)))
  36.     (format t "Opening ~D files..." (length file-pathnames))
  37.     (stream-force-output *standard-output*)
  38.     (mapcar #'(lambda (path-name) (ed path-name))
  39.             file-pathnames)
  40.     (format t "done.~%"))
  41.   (values))
  42.  
  43.  
  44. ; end of file open-all-text-files.lisp
  45. ;-------------------------------------------